home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 03 - 1987 / 03.09 Sep 87 / fortran source / misc stuff / prport folder / prdrag.for < prev    next >
Encoding:
Text File  |  1986-02-06  |  3.6 KB  |  141 lines  |  [TEXT/EDIT]
  1. * This demo program opens the printer as a grafport and writes a
  2. * dragon curve to it.  There must be an Imagewriter file on the 
  3. * system disk for this or any other program using prport.sub to run.
  4. * This program must be compiled with Microsoft FORTRAN 2.1 or later.
  5. * In addition, it uses NEWHANDLE.  The release version of FORTRAN 2.1
  6. * had a bug in this and other memory manager calls.  You should download
  7. * the changes from Compuserve.  It is F77FIX.FOR in DL1 in the MAUG 
  8. * developer's forum.
  9. * 15 Nov 85                            EWG
  10. * 20 Jan 86    Sent to Compuserve.                EWG
  11.  
  12.     program prdrag
  13.  
  14.     implicit none
  15.     integer toolbx
  16.     integer prport                ! Print Manager interface.
  17.  
  18.     include memory.inc
  19.     include misc.inc
  20.  
  21. ! Print Manager function definitions.
  22.     include prport.inc
  23.  
  24.     integer myprport            ! Pointer to printer grafport.
  25.     integer prrechdl            ! Handle to print record.
  26.     logical ok
  27.     integer n                ! Order of curve to draw.
  28.  
  29. ! Print Manager data structures.
  30.     include prdefs.inc
  31.  
  32.     integer*2 qflag            ! Variable to hold bJDocLoop flag.
  33.     integer*1 mystrec(iPrStatSize)    ! Status record for PRPICFILE.
  34.     
  35.     write(9,*) 'This demonstration program prints a ' //
  36.      +        'dragon curve to the'
  37.     write(9,*) 'printer using the printer grafport ' //
  38.      +        'feature of the Macintosh.'
  39.     write(9,*) 'Curves of greater order than 10 ' //
  40.      +        'require a large amount of'
  41.     write(9,*) 'disk space, and may not print on your system.'
  42.     type(9,*) 'Enter order of curve: '
  43.     read(9,*) n
  44.  
  45.     call prport(PROPEN)                ! Open the print manager.
  46.     prrechdl = toolbx(NEWHANDLE, iPrintSize)    ! Get a print record handle.
  47.     call prport(PRINTDEFAULT,prrechdl)        ! Fill it out with default values.
  48.     ok = prport(PRSTLDIALOG, prrechdl)        ! Let the user set the style.
  49.     ok = prport(PRJOBDIALOG, prrechdl)        ! Let the user set up the job.
  50.     if (.not. ok) stop                ! User aborted job.
  51.  
  52.     myprport = prport(PROPENDOC, prrechdl, 0, 0)    ! Get the printer grafport.
  53.  
  54.     if (prport(PRERROR) .NE. 0) then
  55.       write(9,*) "Printer error ",prport(PRERROR)
  56.       stop
  57.     endif
  58.     
  59.     call prport(PROPENPAGE, myprport, 0)        ! Open the first (and only) page.
  60.  
  61.     if (prport(PRERROR) .NE. 0) then
  62.       write(9,*) "Printer error ",prport(PRERROR)
  63.       stop
  64.     endif
  65.     
  66.     call drag(n)                    ! Output some graphics.
  67.  
  68.     call prport(PRCLOSEPAGE, myprport)        ! Close the page.
  69.     call prport(PRCLOSEDOC, myprport)        ! Close the printing grafport.
  70.  
  71.     qflag = byte(long(prrechdl)+prJob+bJDocLoop)    ! Get print method.
  72.  
  73. * If the print method is spooled, the actual printing still needs to be done.
  74.     if ((qflag = bSpoolLoop) .AND. (prport(PRERROR) = 0)) then
  75.       call prport(PRPICFILE, prrechdl, 0, 0, 0, 
  76.      +        toolbx(PTR, mystrec))
  77.     endif
  78.  
  79.     if (prport(PRERROR) .NE. 0) then
  80.       write(9,*) "Printer error ",prport(PRERROR)
  81.       stop
  82.     endif
  83.     
  84.     call prport(PRCLOSE)
  85.     
  86.     end
  87.     
  88.       
  89.     SUBROUTINE DRAG(N)
  90. * This subroutine draws a dragon curve fractal of order N.
  91. * Translated from the Pascal program dragon, from
  92. * "Snowflakes and Dragons" by Matthew Zeidenberg, Macworld,
  93. * August, 1985.
  94.     
  95.     IMPLICIT NONE
  96.  
  97.     INTEGER XORIG, YORIG, SCALING
  98.     PARAMETER (XORIG=400,YORIG=400,SCALING=200)
  99.     
  100.     INTEGER X1,Y1,X2,Y2,X3,Y3,N
  101.     
  102.     X1=XORIG+SCALING
  103.     Y1=YORIG
  104.     X2=XORIG
  105.     Y2=YORIG-SCALING
  106.     X3=XORIG-SCALING
  107.     Y3=YORIG
  108.     
  109.     CALL DRAGONR(X1,Y1,X2,Y2,X3,Y3,N)
  110.     RETURN
  111.     END
  112.     
  113.     SUBROUTINE DRAGONR(X1,Y1,X2,Y2,X3,Y3,N)
  114.     
  115.     IMPLICIT NONE
  116.     
  117.     INTEGER X4,Y4,X5,Y5,YDIFF,XDIFF
  118.     INTEGER X1,Y1,X2,Y2,X3,Y3,N
  119.     INTEGER*4 TOOLBX
  120.  
  121.     include quickdraw.inc
  122.     
  123.     IF (N.EQ.1) THEN
  124.        CALL TOOLBX(MOVETO,Y1,X1)
  125.        CALL TOOLBX(LINETO,Y2,X2)
  126.        CALL TOOLBX(LINETO,Y3,X3)
  127.     ELSE
  128.       X4=((X1+X3)/2)
  129.       Y4=((Y1+Y3)/2)
  130.       X5=X3+(X2-X4)
  131.       Y5=Y3+(Y2-Y4)
  132.       
  133.       CALL DRAGONR(X2,Y2,X4,Y4,X1,Y1,N-1)
  134.       CALL DRAGONR(X2,Y2,X5,Y5,X3,Y3,N-1)
  135.     ENDIF
  136.     
  137.     RETURN
  138.     END
  139.     
  140.     
  141.